home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 11
/
Cream of the Crop 11-1.iso
/
comm
/
ftp4w24b.zip
/
vb
/
ftpproto.frm
< prev
next >
Wrap
Text File
|
1995-02-28
|
13KB
|
485 lines
VERSION 2.00
Begin Form FTP_form
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "FTP file transfer utility "
ClientHeight = 4020
ClientLeft = 1005
ClientTop = 2385
ClientWidth = 8085
Height = 4710
Icon = FTPPROTO.FRX:0000
Left = 945
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4020
ScaleWidth = 8085
Top = 1755
Width = 8205
Begin ListBox Dir_list
Height = 2955
Left = 120
TabIndex = 4
Top = 480
Width = 7815
End
Begin Line Line1
X1 = 0
X2 = 8040
Y1 = 3480
Y2 = 3480
End
Begin Label Message
DragMode = 1 'Automatic
Height = 255
Left = 1320
TabIndex = 1
Top = 3600
Width = 4815
End
Begin Label Label3
BackColor = &H00C0C0C0&
Caption = "Messages :"
Height = 255
Left = 240
TabIndex = 3
Top = 3600
Width = 1095
End
Begin Label Host_name
BackColor = &H00C0C0C0&
Caption = "< Not connected >"
Height = 255
Left = 1680
TabIndex = 2
Top = 120
Width = 1695
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Host :"
Height = 255
Left = 240
TabIndex = 0
Top = 120
Width = 1215
End
Begin Menu Menu_connection
Caption = "&Action"
Begin Menu Menu_connection_item
Caption = "&Connect.."
Index = 0
End
Begin Menu Menu_connection_item
Caption = "&Disconnect.."
Index = 1
End
Begin Menu Menu_connection_item
Caption = "&Abort"
Index = 2
End
Begin Menu Menu_connection_item
Caption = "&Exit"
Index = 3
End
End
Begin Menu Menu_file
Caption = "&File"
Begin Menu Menu_file_item
Caption = "&Get.."
Index = 0
End
Begin Menu Menu_file_item
Caption = "&Put.."
Index = 1
End
End
Begin Menu Menu_directory
Caption = "&Directory"
Begin Menu Menu_directory_item
Caption = "&Change"
Index = 0
End
Begin Menu Menu_directory_item
Caption = "&Parent"
Index = 1
End
Begin Menu Menu_directory_item
Caption = "&Dir list"
Index = 2
End
End
Begin Menu Menu_settings
Caption = "&Settings"
Begin Menu Menu_setting_items
Caption = "&Ascii type"
Index = 0
End
Begin Menu Menu_setting_items
Caption = "&Binary type"
Index = 1
End
Begin Menu Menu_setting_items
Caption = "&Mask"
Index = 2
End
End
Begin Menu Quote_menu
Caption = "&Quote"
Begin Menu Quote_command
Caption = "&Command"
End
End
Begin Menu AboutMenu
Caption = "A&bout"
End
End
Const MB_YESNO = 4, MB_ICONSTOP = 16, MB_DEFBUTTON2 = 256
Const ID_YES = 6, ID_NO = 7
Sub AboutMenu_Click ()
'
Dim Msg, Endofl
Endofl = Chr$(13) & Chr$(10)
'
Msg = " FTP File transfer utility" & Endofl
Msg = Msg & " developed in Visual Basic" & Endofl
Msg = Msg & " by Kees de Rooij and " & Endofl
Msg = Msg & "Richard Terpstra (terpstr2@ksla.nl)" & Endofl
Msg = Msg & " " & Endofl
Msg = Msg & "using FTP4W.DLL from Ph. Jounin (SNCF)" & Endofl
'
MsgBox Msg, 64, "About"
'
End Sub
Sub Disable_menus ()
'
Menu_connection.Enabled = False
Menu_file.Enabled = False
Menu_directory.Enabled = False
Menu_settings.Enabled = False
Quote_menu.Enabled = False
'
End Sub
Sub Do_display_options ()
'
Disable_menus
Ftp_form!Message.Caption = ""
Ftp_form.MousePointer = 11
'
End Sub
Sub Enable_menus ()
'
Menu_connection.Enabled = True
Menu_file.Enabled = True
Menu_directory.Enabled = True
Menu_settings.Enabled = True
Quote_menu.Enabled = True
'
End Sub
Function Exit_program () As Integer
'give a message box to enable the operator to terminate
'the program or not
'
Dim DgDef, Msg, Response, Title
'
Title = "Close application"
Msg = "The application is still connected " & Chr$(13) & Chr$(10)
Msg = Msg & "Do you want to finish anyway ?"
DgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2
Response = MsgBox(Msg, DgDef, Title)
'
Exit_program = Response
'
End Function
Sub Form_Load ()
'
Connected = False
DirType = False
TransType = Asc(TYPE_A)
MaskType = "*.*"
'
Success = FtpInit(Hwnd)
If Success = FTPERR_OK Then
FtpSetSynchronousMode
Success = FtpSetType(TransType)
Else
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
End If
'
End Sub
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
'
'when finishing via - control program checks for connected
'and gives a message to the operator, he then can decide
'to finish or not
'Also a warning will be given when the release was not
'successfull
'
If Connected Then
If Exit_program() = ID_YES Then
Success = FtpLocalClose() 'do both Close
Success = FtpRelease() 'and Release
If Success <> FTPERR_OK Then
MsgBox "The application has not been Released succesfully", 64, "Information"
Cancel = False
End If
Cancel = False
Else
Cancel = True
End If
Else
Ftp_form!Message.Caption = ""
Success = FtpLocalClose() 'do both Close
Success = FtpRelease() 'and Release
If Success <> FTPERR_OK Then
MsgBox "The application has not been Released succesfully", 64, "Information"
End If
Cancel = False
End If
'
End Sub
Sub Menu_connection_Click ()
'set menu active depending on connection
'connect
Menu_connection_item(0).Enabled = (Connected = False)
'disconnect
Menu_connection_item(1).Enabled = (Connected = True)
'abort
Menu_connection_item(2).Enabled = (Connected = True)
'
End Sub
Sub Menu_connection_item_Click (Index As Integer)
'do action depending on item
'
Select Case Index
Case 0 'Connect
ConnectForm.Show 1
If OKDialog = False Then
Exit Sub
End If
Do_display_options
Success = FtpLogin(HostName, Userid, Password, Hwnd, w%)
Undo_display_options
If Success = FTPERR_OK Then
Connected = True
Ftp_form.Host_name.Caption = HostName
Else
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
End If
Case 1 'Disconnect
Do_display_options
Success = FtpCloseConnection()
Undo_display_options
If Success = FTPERR_OK Then
Connected = False
Ftp_form.Host_name.Caption = "< Not connected >"
Else
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
End If
Case 2 'Abort
Do_display_options
Success = FtpAbort()
Undo_display_options
If Success <> FTPERR_OK Then
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
Else
Ftp_form!Message.Caption = "Abort OK"
End If
Case 3 'Exit
If Connected Then 'when connected show tha dialog
If Exit_program() = ID_YES Then
Success = FtpLocalClose() 'do both Close
Success = FtpRelease() 'and Release
If Success <> FTPERR_OK Then
MsgBox "The Application has not been released succesfully", 64, "Info"
End If
End 'exit program
End If
Else 'not connected
Success = FtpLocalClose() 'do both Close
Success = FtpRelease() 'and Release
If Success <> FTPERR_OK Then
MsgBox "The Application has not been released succesfully", 64, "Info"
End If
End 'exit program
End If
End Select
'
End Sub
Sub Menu_directory_Click ()
'set menu active depending on connection
'change
Menu_directory_item(0).Enabled = (Connected = True)
'parent
Menu_directory_item(1).Enabled = (Connected = True)
'dir list
Menu_directory_item(2).Enabled = (Connected = True)
'
End Sub
Sub Menu_directory_item_Click (Index As Integer)
'
Dim C_dir$
'
Select Case Index
Case 0 'change
C_dir$ = InputBox$("Enter directory name : ", "Change directory")
Do_display_options
Success = FtpCWD(C_dir$)
Undo_display_options
If Success <> FTPERR_OK Then
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
Else
Ftp_form!Message.Caption = "Change dir OK"
End If
Case 1 'parent
C_dir$ = ".."
Do_display_options
Success = FtpCWD(C_dir$)
Undo_display_options
If Success <> FTPERR_OK Then
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
Else
Ftp_form!Message.Caption = "Change dir OK"
End If
Case 2
DirType = False
Do_display_options
Do_the_dirlist
Ftp_form.MousePointer = 0
Enable_menus
End Select
'
End Sub
Sub Menu_file_Click ()
'set menu active depending on connection
'put
Menu_file_item(0).Enabled = (Connected = True)
'get
Menu_file_item(1).Enabled = (Connected = True)
'
End Sub
Sub Menu_file_item_Click (Index As Integer)
'
Select Case Index
Case 0 'get
Get_file.Show 1
If OKDialog = False Then Exit Sub
'
Do_display_options
Success = FtpRecvFile(Src_nam, Dest_nam, TransType, BNotify%, Hwnd, Msg%)
Undo_display_options
If Success <> FTPERR_OK Then
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
Else
Ftp_form!Message.Caption = "Receive file OK"
End If
Case 1 'put
Put_file.Show 1
If OKDialog = False Then Exit Sub
Do_display_options
Success = FtpSendFile(Src_nam, Dest_nam, TransType, BNotify%, Hwnd, Msg%)
Undo_display_options
If Success <> FTPERR_OK Then
Ms$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = Ms$
Else
Ftp_form!Message.Caption = "Send file OK"
End If
End Select
'
End Sub
Sub Menu_setting_items_Click (Index As Integer)
'
Select Case Index
Case 0 'Ascii
TransType = Asc(TYPE_A)
Case 1 'binary
TransType = Asc(TYPE_I)
Case 2 'mask
MaskType = Get_mask_type()
Do_display_options
Do_the_dirlist
Ftp_form.MousePointer = 0
Enable_menus
End Select
'
End Sub
Sub Menu_settings_Click ()
'
Menu_setting_items(0).Checked = (TransType = Asc(TYPE_A))
Menu_setting_items(1).Checked = (TransType = Asc(TYPE_I))
'
Menu_setting_items(0).Enabled = (Connected = True)
Menu_setting_items(1).Enabled = (Connected = True)
Menu_setting_items(2).Enabled = (Connected = True)
'
End Sub
Sub Quote_command_Click ()
'execute a command not implemented as standard command
'in FTP4W.BAS
'
Dim Answ$, DefVal, Msg, Title
Dim Result As String
'
Result = String$(255, 32) 'init the string ! essential
'
DefVal = ""
Msg = "Enter FTP command : "
Title = "Quote option for FTP"
'
Answ$ = InputBox$(Msg, Title, DefVal)
If Len(Trim$(Answ$)) = 0 Then
Exit Sub
Else
Do_display_options
Success = FtpQuote(Answ$, Result, Len(Result))
Undo_display_options
If Success = FTPERR_OK Then
Result = Trim$(Result)
Result = Left$(Result, Len(Result) - 1)
Ftp_form!Message.Caption = "FTP Quote OK" 'Result
Else
M$ = FTP4W_Error(Success)
Ftp_form!Message.Caption = M$
End If
End If
'
End Sub
Sub Quote_menu_Click ()
'
Quote_command.Enabled = (Connected = True)
'
End Sub
Sub Undo_display_options ()
'
Ftp_form.MousePointer = 0
Enable_menus
'
End Sub